Visual Basic Controls

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / w3d / wire3d.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1998-04-30 | 27.1 KB | 893 lines

VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "Comdlg32.ocx" Object = "{82427AF4-E037-11D1-BDEA-000000000000}#1.0#0"; "W3D.ocx" Begin VB.Form w3Dfrm AutoRedraw = -1 'True Caption = "Wire3D" ClientHeight = 5208 ClientLeft = 816 ClientTop = -720 ClientWidth = 8076 Icon = "wire3D.frx":0000 LinkTopic = "Form1" ScaleHeight = 5208 ScaleWidth = 8076 Begin W3D.W3Dctl W3Dctl1 Height = 3504 Left = 36 TabIndex = 46 Top = 36 Width = 4260 _ExtentX = 7514 _ExtentY = 6181 End Begin VB.TextBox Text3 Height = 252 Left = 6480 TabIndex = 42 Text = "1" Top = 2124 Width = 336 End Begin VB.TextBox Text2 Height = 240 Left = 6480 TabIndex = 40 Text = "1" Top = 1008 Width = 336 End Begin VB.CommandButton Command5 Caption = "a,A,b,B,c,C" Height = 264 Left = 2772 TabIndex = 37 Top = 4860 Width = 1500 End Begin VB.CommandButton Command4 Caption = "z,Z,x,X,y,Y" Height = 264 Left = 1260 TabIndex = 36 Top = 4860 Width = 1500 End Begin VB.CommandButton Command6 Caption = "L,R,U,D" Height = 264 Left = 2772 TabIndex = 34 Top = 4572 Width = 1500 End Begin VB.CommandButton Command3 Caption = "left,right,up,down" Height = 264 Left = 1260 TabIndex = 33 Top = 4572 Width = 1500 End Begin VB.CommandButton Command1 Caption = "add " Height = 228 Left = 5652 TabIndex = 26 Top = 1476 Width = 1632 End Begin VB.CommandButton Command2 Caption = "remove " Height = 228 Left = 5652 TabIndex = 25 Top = 1728 Width = 1632 End Begin VB.TextBox Text6 Height = 288 Index = 9 Left = 5004 TabIndex = 24 Text = "0" Top = 2124 Width = 516 End Begin VB.TextBox Text6 Height = 288 Index = 10 Left = 5004 TabIndex = 23 Text = "0" Top = 1800 Width = 516 End Begin VB.TextBox Text6 Height = 288 Index = 11 Left = 5004 TabIndex = 22 Text = "0" Top = 1476 Width = 516 End Begin VB.Frame Frame6 Caption = "p1" Height = 1236 Index = 0 Left = 4680 TabIndex = 15 Top = 108 Width = 876 Begin VB.TextBox Text6 Height = 288 Index = 2 Left = 252 TabIndex = 18 Text = "0" Top = 828 Width = 516 End Begin VB.TextBox Text6 Height = 288 Index = 1 Left = 252 TabIndex = 17 Text = "0" Top = 504 Width = 516 End Begin VB.TextBox Text6 Height = 288 Index = 0 Left = 252 TabIndex = 16 Text = "0" Top = 180 Width = 516 End Begin VB.Label Label2 Caption = "z=" Height = 228 Index = 2 Left = 72 TabIndex = 21 Top = 864 Width = 192 End Begin VB.Label Label2 Caption = "y=" Height = 228 Index = 1 Left = 72 TabIndex = 20 Top = 540 Width = 192 End Begin VB.Label Label2 Caption = "x=" Height = 228 Index = 0 Left = 72 TabIndex = 19 Top = 216 Width = 192 End End Begin VB.Frame Frame6 Caption = "p2" Height = 1236 Index = 1 Left = 5616 TabIndex = 8 Top = 108 Width = 840 Begin VB.TextBox Text6 Height = 288 Index = 5 Left = 252 TabIndex = 11 Text = "0" Top = 828 Width = 516 End Begin VB.TextBox Text6 Height = 288 Index = 4 Left = 252 TabIndex = 10 Text = "0" Top = 504 Width = 516 End Begin VB.TextBox Text6 Height = 288 Index = 3 Left = 252 TabIndex = 9 Text = "0" Top = 180 Width = 516 End Begin VB.Label Label2 Caption = "x=" Height = 228 Index = 5 Left = 72 TabIndex = 14 Top = 216 Width = 192 End Begin VB.Label Label2 Caption = "y=" Height = 228 Index = 4 Left = 72 TabIndex = 13 Top = 540 Width = 192 End Begin VB.Label Label2 Caption = "z=" Height = 228 Index = 3 Left = 72 TabIndex = 12 Top = 864 Width = 192 End End Begin VB.CommandButton Command11 Caption = "remove " Height = 228 Left = 6480 TabIndex = 7 Top = 468 Width = 800 End Begin VB.CommandButton Command10 Caption = "add " Height = 228 Left = 6480 TabIndex = 6 Top = 216 Width = 800 End Begin VB.PictureBox pCol Appearance = 0 'Flat AutoRedraw = -1 'True AutoSize = -1 'True BackColor = &H80000005& ForeColor = &H80000008& Height = 912 Left = 5850 Picture = "wire3D.frx":030A ScaleHeight = 888 ScaleWidth = 1716 TabIndex = 0 Top = 2430 Width = 1740 End Begin MSComDlg.CommonDialog CommonDialog1 Left = 6912 Top = 5976 _ExtentX = 699 _ExtentY = 699 _Version = 327680 End Begin VB.OptionButton Option3 Caption = "background" Height = 228 Left = 4392 TabIndex = 3 Top = 3276 Width = 1344 End Begin VB.OptionButton Option2 Caption = "point" Height = 192 Left = 4392 TabIndex = 2 Top = 3024 Width = 984 End Begin VB.OptionButton Option1 Caption = "line" Height = 192 Left = 4392 TabIndex = 1 Top = 2736 Value = -1 'True Width = 948 End Begin VB.PictureBox Picture1 Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& ForeColor = &H80000008& Height = 1512 Left = 4320 Picture = "wire3D.frx":802C ScaleHeight = 1488 ScaleWidth = 2940 TabIndex = 4 Top = 3600 Width = 2964 End Begin VB.TextBox Text1 Appearance = 0 'Flat BackColor = &H00C0FFC0& Height = 948 Left = 36 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 5 Text = "wire3D.frx":1E4EE Top = 3600 Width = 4230 End Begin VB.CheckBox Check1 Caption = "tile" BeginProperty Font Name = "Arial" Size = 7.8 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 156 Left = 756 TabIndex = 39 Top = 4752 Width = 768 End Begin VB.Shape Shape2 FillStyle = 0 'Solid Height = 264 Left = 6948 Top = 1008 Width = 336 End Begin VB.Shape Shape3 FillStyle = 0 'Solid Height = 264 Left = 6948 Top = 2124 Width = 336 End Begin VB.Label Label10 Caption = "color" Height = 192 Left = 6912 TabIndex = 45 Top = 1944 Width = 516 End Begin VB.Label Label9 Caption = "color" Height = 192 Left = 6912 TabIndex = 44 Top = 828 Width = 516 End Begin VB.Label Label8 Caption = "width" Height = 192 Left = 6480 TabIndex = 43 Top = 1944 Width = 444 End Begin VB.Label Label7 Caption = "width" Height = 192 Left = 6480 TabIndex = 41 Top = 828 Width = 444 End Begin VB.Label Label1 Caption = "color" BeginProperty Font Name = "MS Sans Serif" Size = 7.8 Charset = 177 Weight = 400 Underline = -1 'True Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 192 Left = 4320 TabIndex = 32 Top = 2484 Width = 876 End Begin VB.Line Line2 X1 = 7272 X2 = 4284 Y1 = 2448 Y2 = 2448 End Begin VB.Line Line1 X1 = 7272 X2 = 4284 Y1 = 1404 Y2 = 1404 End Begin VB.Label Label2 Caption = "z=" Height = 228 Index = 9 Left = 4824 TabIndex = 29 Top = 2160 Width = 192 End Begin VB.Label Label2 Caption = "y=" Height = 228 Index = 10 Left = 4824 TabIndex = 28 Top = 1836 Width = 192 End Begin VB.Label Label2 Caption = "x=" Height = 228 Index = 11 Left = 4824 TabIndex = 27 Top = 1512 Width = 192 End Begin VB.Label Label3 Caption = "line" BeginProperty Font Name = "MS Sans Serif" Size = 7.8 Charset = 177 Weight = 400 Underline = -1 'True Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 4320 TabIndex = 30 Top = 30 Width = 480 End Begin VB.Label Label4 Caption = "point" BeginProperty Font Name = "MS Sans Serif" Size = 7.8 Charset = 177 Weight = 400 Underline = -1 'True Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 228 Left = 4320 TabIndex = 31 Top = 1440 Width = 696 End Begin VB.Label Label5 Caption = "XYZ system" Height = 228 Left = 36 TabIndex = 35 Top = 4536 Width = 1236 End Begin VB.Label Label6 Caption = "3D figure" Height = 228 Left = 36 TabIndex = 38 Top = 4932 Width = 1560 End Begin VB.Menu File Caption = "&File" Index = 1 Begin VB.Menu mnuLoad Caption = "&Load 3D figure" Index = 1 Begin VB.Menu loadWObounds Caption = "with&out saved boundaries" Index = 18 End Begin VB.Menu loadWbounds Caption = "&with saved boundaries" Index = 19 End End Begin VB.Menu mnuAddFigure Caption = "&Add 3D figure" Index = 30 End Begin VB.Menu mnuSave Caption = "&Save 3D figure" Index = 3 End Begin VB.Menu mnuBackGroundPicture Caption = "Load &Background Picture" Index = 2 End Begin VB.Menu mnuSaveAsPicture Caption = "Sa&ve as Picture" Index = 4 End Begin VB.Menu mnuPrint Caption = "&Print" Index = 5 End Begin VB.Menu mnuExit Caption = "&Exit" Index = 6 End End Begin VB.Menu mnuAction Caption = "&Action" Index = 7 Begin VB.Menu mnuClear3Dall Caption = "Clear 3D &All" Index = 14 End Begin VB.Menu mnuClearAll3Dlines Caption = "Clear 3D &Lines" Index = 10 End Begin VB.Menu mnuClearBackGroundPicture Caption = "Clear &Background Picture" Index = 8 End Begin VB.Menu mnuZoom Caption = "&Zoom" Index = 11 WindowList = -1 'True Begin VB.Menu mnuZoomIn Caption = "&In ( x 2 )" Index = 12 End Begin VB.Menu mnuZoomOut Caption = "&Out ( x 0.5 )" Index = 13 End End End Begin VB.Menu mnuProperties Caption = "&Properties" Index = 21 End Attribute VB_Name = "w3Dfrm" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim isPressed As Boolean Private Sub Command1_Click() W3Dctl1.AddPoint3D Val(Text6(11)), Val(Text6(10)), Val(Text6(9)), Val(Text3), Shape3.FillColor End Sub Private Sub Command10_Click() W3Dctl1.AddLine3D Val(Text6(0)), Val(Text6(1)), Val(Text6(2)), Val(Text6(3)), Val(Text6(4)), Val(Text6(5)), Val(Text2), Shape2.FillColor End Sub Private Sub Command11_Click() W3Dctl1.RemoveLine3D Val(Text6(0)), Val(Text6(1)), Val(Text6(2)), Val(Text6(3)), Val(Text6(4)), Val(Text6(5)), True End Sub Private Sub Command2_Click() W3Dctl1.RemovePoint3D Val(Text6(11)), Val(Text6(10)), Val(Text6(9)), True End Sub Private Sub Command3_Click() Static i As Integer Dim j As Double i = i + 1 For j = 1 To 360 Step 10 Select Case i Mod 4 Case 1: W3Dctl1.angle1 = W3Dctl1.angle1 + 10 Case 2: W3Dctl1.angle1 = W3Dctl1.angle1 - 10 Case 3: W3Dctl1.angle2 = W3Dctl1.angle2 + 10 Case 0: W3Dctl1.angle2 = W3Dctl1.angle2 - 10 End Select 'change CheckBox "tail" status W3Dctl1.Show3D 1 - Check1.Value DoEvents Next j End Sub Private Sub Command4_Click() Static i As Integer Dim j As Double i = i + 1 For j = 1 To 360 Step 10 Select Case i Mod 6 Case 1: W3Dctl1.rotateByZaxe 10 Case 2: W3Dctl1.rotateByZaxe -10 Case 3: W3Dctl1.rotateByXaxe 10 Case 4: W3Dctl1.rotateByXaxe -10 Case 5: W3Dctl1.rotateByYaxe 10 Case 0: W3Dctl1.rotateByYaxe -10 End Select 'change CheckBox "tail" status W3Dctl1.Show3D 1 - Check1.Value DoEvents Next j End Sub Private Sub Command5_Click() Static i As Integer i = i + 1 Select Case i Mod 6 Case 1: W3Dctl1.vector 2, 0, 0 Case 2: W3Dctl1.vector 0, 2, 0 Case 3: W3Dctl1.vector 0, 0, 2 Case 4: W3Dctl1.vector -2, 0, 0 Case 5: W3Dctl1.vector 0, -2, 0 Case 0: W3Dctl1.vector 0, 0, -2 End Select 'change CheckBox "tail" status W3Dctl1.Show3D 1 - Check1.Value End Sub Private Sub Command6_Click() Static i As Integer i = i + 1 W3Dctl1.SetFocus Select Case i Mod 4 Case 1: W3Dctl1.showVector -1, 0 Case 2: W3Dctl1.showVector 1, 0 Case 3: W3Dctl1.showVector 0, 1 Case 0: W3Dctl1.showVector 0, -1 End Select 'change CheckBox "tail" status W3Dctl1.Show3D 1 - Check1.Value End Sub Private Sub loadWbounds_Click(Index As Integer) W3Dctl1.ClearAll3D LoadFigure True End Sub Private Sub loadWObounds_Click(Index As Integer) W3Dctl1.ClearAll3D LoadFigure False End Sub Private Sub mnuAddFigure_Click(Index As Integer) LoadFigure False End Sub Private Sub mnuBackGroundPicture_Click(Index As Integer) On Error GoTo eee CommonDialog1.CancelError = True CommonDialog1.Filter = "Pictures (*.bmp;*.dib;*.gif;*.jpg;*.wmf;*.emf)|*.bmp;*.bmp;*.dib;*.gif;*.jpg;*.wmf;*.emf" CommonDialog1.filename = "" CommonDialog1.ShowOpen If CommonDialog1.FileTitle = "" Then Exit Sub W3Dctl1.PictureFileName = CommonDialog1.filename mnuClearBackGroundPicture.Item(8).Enabled = True End Sub Private Sub LoadFigure(withSavedBounds As Boolean) On Error GoTo eee CommonDialog1.CancelError = True CommonDialog1.Filter = "Graphs (*.grh)|*.grh" CommonDialog1.filename = "" CommonDialog1.ShowOpen If CommonDialog1.FileTitle = "" Then Exit Sub If withSavedBounds Then W3Dctl1.LoadFigure CommonDialog1.filename, True Else W3Dctl1.LoadFigure CommonDialog1.filename End If End Sub Private Sub mnuClear3Dall_Click(Index As Integer) W3Dctl1.ClearAll3D End Sub Private Sub mnuClearAll3Dlines_Click(Index As Integer) W3Dctl1.ClearAll3Dsegments End Sub Private Sub mnuClearBackGroundPicture_Click(Index As Integer) W3Dctl1.PictureFileName = "" mnuClearBackGroundPicture.Item(8).Enabled = False End Sub Private Sub mnuProperties_Click(Index As Integer) With wproperties .txtXmin = W3Dctl1.Xmin .txtXmax = W3Dctl1.Xmax .txtYmin = W3Dctl1.Ymin .txtYmax = W3Dctl1.Ymax .txtZmin = W3Dctl1.Zmin .txtZmax = W3Dctl1.Zmax If W3Dctl1.isPerspective Then .Option2.Value = 1 Else .Option1.Value = 1 End If If W3Dctl1.SelectLineByMouse Then .CheckLines.Value = 1 Else .CheckLines.Value = 0 End If If W3Dctl1.SelectPointByMouse Then .CheckPoints.Value = 1 Else .CheckPoints.Value = 0 End If If W3Dctl1.show3Daxes Then .Checkshow3Daxes.Value = 1 Else .Checkshow3Daxes.Value = 0 End If If W3Dctl1.show3DaxesNames Then .CheckAxesNames.Value = 1 Else .CheckAxesNames.Value = 0 End If If W3Dctl1.show3Dboundaries Then .Checkshow3Dbound.Value = 1 Else .Checkshow3Dbound.Value = 0 End If If W3Dctl1.drawXYZproportional2Ranges Then .CheckXYZproportional.Value = 1 Else .CheckXYZproportional.Value = 0 End If If W3Dctl1.show3DplaneXY Then .CheckShow3DplaneXY.Value = 1 Else .CheckShow3DplaneXY.Value = 0 End If End With With W3Dctl1 oldXmin = .Xmin oldXmax = .Xmax oldYmin = .Ymin oldYmax = .Ymax oldZmin = .Zmin oldZmax = .Zmax OldshowIsPerspective = .isPerspective Oldshow3DplaneXY = .show3DplaneXY oldshow3Dboundaries = .show3Dboundaries olddrawXYZproportional2Ranges = .drawXYZproportional2Ranges oldshow3Daxes = .show3Daxes oldshow3DaxesNames = .show3DaxesNames oldSelectPointByMouse = .SelectPointByMouse oldSelectLineByMouse = .SelectLineByMouse End With wproperties.Show vbModal End Sub Private Sub Form_Load() Randomize isPressed = False TW_X = Screen.TwipsPerPixelX TW_Y = Screen.TwipsPerPixelY With W3Dctl1 Shape2.FillColor = .LineColor '.Xmin = -40 '.Xmax = 10 '.Ymin = -10 '.Ymax = 10 '.Zmin = -10 '.Zmax = 10 '.show3Dboundaries = True '.drawXYZproportional2Ranges = True '.show3Daxes = True '.LineColor = vbBlue '.isPerspective = False End With pCol.Left = Picture1.Left + Picture1.width - pCol.width pCol.Top = Line2.y1 + (Picture1.Top - Line2.y1 - pCol.Height) / 2 Line2.x1 = pCol.Left + pCol.width - TW_X Height = Picture1.Top + Picture1.Height + (GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CYCAPTION) + 2 * GetSystemMetrics(SM_CYFRAME) + 4) * TW_Y width = Picture1.Left + Picture1.width + (2 * GetSystemMetrics(SM_CXFRAME) + 4) * TW_X Top = (Screen.Height - Height) / 2 Left = (Screen.width - width) / 2 Dim yy As Integer yy = Picture1.Top + Picture1.Height Command4.Top = yy - Command4.Height Command5.Top = yy - Command5.Height Label6.Top = yy - Label6.Height yy = yy - Command5.Height - TW_Y Command3.Top = yy - Command3.Height Command6.Top = yy - Command6.Height Label5.Top = yy - Label5.Height yy = yy - Command3.Height - 2 * TW_Y Text1.Height = yy - Text1.Top Check1.Top = Label6.Top + (Label5.Top + Label5.Height - Label6.Top - Check1.Height) / 2 mnuClearBackGroundPicture.Item(8).Enabled = False End Sub Private Sub mnuExit_Click(Index As Integer) Unload Me End Sub Private Sub mnuPrint_Click(Index As Integer) W3Dctl1.PrintImage End Sub Private Sub mnuSave_Click(Index As Integer) Dim i As Integer On Error GoTo aaa CommonDialog1.CancelError = True CommonDialog1.Filter = "Graphs (*.grh)|*.grh" CommonDialog1.filename = "" CommonDialog1.ShowSave If CommonDialog1.FileTitle = "" Then Exit Sub W3Dctl1.SaveFigure CommonDialog1.filename End Sub Private Sub mnuSaveAsPicture_Click(Index As Integer) On Error GoTo aaa CommonDialog1.CancelError = True CommonDialog1.Filter = "Picture (*.bmp)|*.bmp|" CommonDialog1.filename = "" CommonDialog1.ShowSave If CommonDialog1.FileTitle = "" Then Exit Sub W3Dctl1.SaveImage CommonDialog1.filename End Sub Private Sub mnuZoomIn_Click(Index As Integer) W3Dctl1.Zoom 0.5 W3Dctl1.Show3D True End Sub Private Sub mnuZoomOut_Click(Index As Integer) W3Dctl1.Zoom 2 W3Dctl1.Show3D True End Sub Private Sub pCol_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) On Error Resume Next isPressed = True If Option1.Value = True Then Shape2.FillColor = pCol.Point(x, y) W3Dctl1.LineColor = Shape2.FillColor End If If Option2.Value = True Then Shape3.FillColor = pCol.Point(x, y) If Option3.Value = True Then W3Dctl1.BackColor = pCol.Point(x, y) End Sub Private Sub pCol_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) On Error Resume Next If isPressed Then If Option1.Value = True Then Shape2.FillColor = pCol.Point(x, y) W3Dctl1.LineColor = Shape2.FillColor End If If Option2.Value = True Then Shape3.FillColor = pCol.Point(x, y) If Option3.Value = True Then W3Dctl1.BackColor = pCol.Point(x, y) End If End Sub Private Sub pCol_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) On Error Resume Next If isPressed Then If Option1.Value = True Then Shape2.FillColor = pCol.Point(x, y) W3Dctl1.LineColor = Shape2.FillColor End If If Option2.Value = True Then Shape3.FillColor = pCol.Point(x, y) If Option3.Value = True Then W3Dctl1.BackColor = pCol.Point(x, y) isPressed = False End If End Sub Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 0 End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub W3Dctl1_LineSelected(x1 As Double, y1 As Double, z1 As Double, x2 As Double, y2 As Double, z2 As Double, width As Integer, color As Long) Text6(0) = x1 Text6(1) = y1 Text6(2) = z1 Text6(3) = x2 Text6(4) = y2 Text6(5) = z2 Text2 = width Shape2.FillColor = color End Sub Private Sub W3Dctl1_PointSelected(x As Double, y As Double, z As Double, width As Integer, color As Long) Text6(11) = x Text6(10) = y Text6(9) = z Text3 = width Shape3.FillColor = color End Sub